perm filename GEODPY.SAI[GEO,BGB]1 blob
sn#001299 filedate 1972-10-28 generic text, type T, neo UTF8
00100 ENTRY DUMMY;
00200 BEGIN "GEODPY"
00300 REQUIRE "ABBREV" SOURCE_FILE;
00400 REQUIRE "GEOMES" SOURCE_FILE;
00500 REQUIRE "SAITRG" SOURCE_FILE;
00600 EXTERNAL SUBR OCCULT;
00700 EXTERNAL SUBR KLTEMP;
00800
00900 α DEFINITIONS;
01000
01100 DEFINE mm = "3.2808@-3";
01200 DEFINE PPIOT="'702000000000";
01300 DEFINE THRICE="FOR I←1 STEP 1 UNTIL 3 DO";
01400 DEFINE PUSH= "PADPDL[PDLPTR←PDLPTR+1]";
01500 DEFINE POP = "PADPDL[1+(PDLPTR←PDLPTR-1)]";
01600 DEFINE TOP = "PADPDL[PDLPTR]";
01700 DEFINE ARG1= "PADPDL[PDLPTR-1]";
01800 DEFINE ARG2= "PADPDL[PDLPTR-2]";
01900
02000 α ITEM STRING;
02100 EXTERNAL STRING ARRAY NAME[1:50];
02200 EXTERNAL ITG BGND;
02300
02400 INTERNAL STRING SUBR ISTR (ITG Q); ⊂
02500 STRING STR; ITG SERIAL,I;
02600 IF Q=0 THEN RETURN("ZERO");
02700 IF Q=WORLD THEN RETURN("WORLD");
02800 IF Q=BGND THEN RETURN("BGND");
02900 IF Q=CDR(WORLD-4) THEN RETURN("CAMERA");
03000 I ← ITYPE(Q);
03100 SERIAL ← (IF I≠Q THEN CDR(Q) ELSE 0);
03200 IF I=1 THEN STR←NAME[PNAME(Q)] ELSE
03300 STR ← "UBFEV"[(I+1)FOR 1]&CVS(SERIAL);
03400 RETURN(STR); ⊃;
03500
00100 α GEOMED'S CONTEXT;
00200 EXTERNAL ITG ARRAY PADPDL[0:99];
00300 EXTERNAL ITG PDLPTR;
00400 α TRANSFORMATION STRENGTHS;
00500 EXTERNAL REAL TDEL,DDEL,RDEL;
00600 α THE CURRENT TTY COMMAND STATE;
00700 EXTERNAL INTEGER CHR,CTRL,META,LETT,αβ,
00800 α EUCLIDEAN TRANSFORMATION SWITCHES;
00900 OP, α CONTROL BITS TRANSF OP;
01000 OPERATION, α DEFAULT TRANSF OP;
01100 FRAME, α TRANSF FRAME OF REFERENCE;
01200 FRMORG, α FRAME ORGIN SWITCH;
01300 AXECNT, α NUMBER OF DILATION/REFLECTION AXES;
01400 α DISPLAY MODE SWITCHES;
01500 FLAGD, α DATUM DISPLAY MODE;
01600 FLAGV, α VERTEX MARKER MODE;
01700 FLAGRS, α REFRESH SUPRRESS;
01800 FLAGED, α SUPPRES EDITOR STATUS;
01900 FLAGL; α SHOW PNAMES FLAG;
02000 EXTERNAL INTEGER VERNX,VERNY;
02100 EXTERNAL INTEGER ITERATIONS;
02200
02300 EXTERNAL STRING TITLE;
00100 α SUN POSITION AND PICTURE TIME AND DATE;
00200 REAL SUNAZM,SUNALT,EAST,NORTH,ZENITH,TIME;
00300 REAL CAMAZM,CAMALT;
00400 INTEGER DATE,MONTH,DAYS,DAY,HOUR,MIN;
00500 STRING DAYTIME;
00600
00700 α SOLAR EPHEMERIS - CIRCULAR APPROXIMATION GEOCENTRIC;
00800 SUBR SUN;
00900 BEGIN "SUN"
01000 REAL RHO,PHI,TMP; ITG CAM;
01100 DEFINE LAB = "(153*π/180)";
01200 DEFINE LAT = "((37+23/60)*π/180)";
01300 DEFINE ECLIPTIC = "((23+27/60)*π/180)";
01400 RHO ← 2*π*DAYS/365.25;
01500
01600 α POSITION OF THE SUN ON THE ECLIPTIC IN THE CELESTIAL SPHERE;
01700 EAST ← SIN(RHO)*COS(ECLIPTIC);
01800 NORTH ← SIN(RHO)*SIN(ECLIPTIC);
01900 ZENITH ← COS(RHO);
02000
02100 α LOCAL MERIDIAN OF LONGITUDE IS APPARENT SOLAR TIME = (P.S.T. - 8:44);
02200 PHI ← π*(1-(TIME-1)/12) - ATAN2(EAST,ZENITH);
02300 TMP ← ZENITH*COS(PHI) - SIN(PHI)*EAST;
02400 EAST ← EAST*COS(PHI) + SIN(PHI)*ZENITH;
02500 ZENITH ← TMP;
02600
02700 α ROTATE CW IN THE NORTH/ZENITH PLANE TO THE LOCAL LATITUDE;
02800 TMP ← COS(LAT)*ZENITH + SIN(LAT)*NORTH;
02900 NORTH ← COS(LAT)*NORTH - SIN(LAT)*ZENITH;
03000 ZENITH ← TMP;
03100
03200 α ROTATE CW TO LAB COORDINATES;
03300 EAST ← COS(LAB)*EAST + SIN(LAB)*NORTH;
03400 NORTH ← COS(LAB)*NORTH - SIN(LAB)*EAST ;
03500
03600 α CONVERT TO ANGULAR MEASURES;
03700 SUNAZM ← ATAN2 (NORTH,EAST);
03800 SUNALT ← π/2 - ACOS (ZENITH);
03900 CAM ← CDR(WORLD-4); CAM ← CDR(CAM-2);
04000 CAMAZM ← ATAN2(-KY(CAM),-KX(CAM));
04100 CAMALT ← ACOS(KZ(CAM))-π/2;
04200 IF ABS(ABS(CAMALT)-π/2)<π/180 THEN CAMAZM←0;
04300 END "SUN";
00100 SUBR SUNTIME;
00200 BEGIN "SUNTIME"
00300 TIME ← CALL(0,"MSTIME")/(1000*60*60);
00400 HOUR ← TIME MOD 12;
00500 MIN ← TIME*60 MOD 60;
00600 DATE ← CALL(0,"DATE");
00700 DAY ← (DATE MOD 31)+1;
00800 MONTH ← ((DATE % 31)MOD 12)+1;
00900 α DAYS SINCE THE SPRING EQUINOX - MARCH 21 IS DAY ZERO;
01000 DAYS ← ((CASE(MONTH-1)OF(286,314,345,10,41,71,
01100 102,133,163,194,224,255))+DAY) MOD 366;
01200 SETFORMAT(2,7); DAYTIME←CVS(HOUR)&":";
01300 SETFORMAT(-2,7); DAYTIME←DAYTIME&CVS(MIN);
01400 DAYTIME ← DAYTIME&(IF TIME≥12 THEN " PM " ELSE " AM ");
01500 SETFORMAT(0,7); DAYTIME←DAYTIME&CVS(DAY)&" "&
01600 (CASE(MONTH-1)OF("JAN","FEB","MAR","APR","MAY","JUN","JUL",
01700 "AUG","SEPT","OCT","NOV","DEC"))&" 1972";
01800 END "SUNTIME";
00100 REQUIRE "DPYIII" SOURCE_FILE;
00200 SUBR DPYSVS(INTEGER X,Y;STRING STR0);
00300 BEGIN AIVECT(X,Y);DPYSST(STR0)END;
00310 SUBR DPYSTR(STRING STR);
00355 ⊂ STRING S;S←STR;DPYSST(S);S←"";⊃;
00400
00500 SAFE INTERNAL ITG ARRAY DPYBUF[1:1500];
00600
00700 INTERNAL SUBR PLOT;
00800 BEGIN
00900 STRING FILNAM;
01000 INTEGER FLG,CHN;
01100 CHN ← GETCHAN;
01200 OPEN(CHN,"DSK",8,0,3,0,0,0);
01300 DO BEGIN
01400 OUTSTR(13&10&"PLOT FILE = ");
01500 FILNAM ← INCHWL;
01600 ENTER(CHN,FILNAM&".PLT",FLG);
01700 END UNTIL ¬FLG;
01800 ARRYOUT(CHN,DPYBUF[1],DPYBUF[2]);
01900 RELEASE(CHN);
02000 END;
02100
02200 SUBR DPYFRAME(ITG W);
02300 BEGIN
02400 ITG XL,XH,YL,YH;
02500 XL ← LACR(W+#XL); XH ← LACR(W+#XH);
02600 YL ← LACR(W+#YL); YH ← LACR(W+#YH);
02700 AIVECT(XL,YL);
02800 AVECT(XH,YL);
02900 AVECT(XH,YH);
03000 AVECT(XL,YH);
03100 AVECT(XL,YL);
03200 END;
00100 α DISPLAY THE OBJECTS;
00200 INTERNAL SUBR DPYSUB (ITG COMMAND);
00300 BEGIN "DPYSUB"
00400 EXTERNAL SUBR KLJOTS;
00500 EXTERNAL SUBR KLJUTS;
00600 α EXTERNAL SUBR MAKVID;
00700 LABEL L1,L2;
00800 ITG CAM,SWN,OWINDO,DPY,ELIST,QLIST,Q;
00900 IF FLAGRS THEN RETURN;
01000
01100 α FOREACH CAM|CAMεWORLD DO;
01200 CAM ← WORLD;
01300 L1: CAM ← CDR(CAM+#CAMERA);
01400 IF CAM≠WORLD THEN ⊂
01500 α FOREACH SWN|SWNεCAM DO;
01600 SWN ← CAM;
01700 L2: SWN ← CDR(SWN+#QRING);
01800 IF SWN≠CAM THEN ⊂
01900
02000 α DO A DISPLAY MAPPING CAMERA → SWINDO → OWINDO → DPY;
02100 PROJECTOR(CAM,WORLD);
02200 OWINDO ← CDR(SWN);
02300 DPY ← CDR(OWINDO);
02400 IF COMMAND=0 THEN EMARKALL(WORLD) ELSE
02500 ⊂ FMARK(WORLD); EMARK(WORLD);⊃;
02600 IF COMMAND≥2 THEN ⊂ OCCULT;
02700 α IF COMMAND=3 THEN MAKVID;
02800 KLJOTS;⊃;
02900 QLIST ← ELIST ← CLIPER(OWINDO,WORLD);
03000
03100 QLIST←QLIST LAND '777777;
03200 DPYSET(DPYBUF);
03300 DPYFRAME(OWINDO);
03400 WHILE QLIST≠0 DO
03500 ⊂ Q←QLIST;AIVECT(X1DC(Q),Y1DC(Q));
03600 AVECT(X2DC(Q),Y2DC(Q));
03700 QLIST ← CDR(QLIST-1);⊃;
03800 IF COMMAND≥2 THEN ⊂ KLJUTS;KLTEMP;⊃;
03900 DPYFRAME(OWINDO);
04000 GO L2;⊃;
04100 GO L1;⊃;
04200
04300 α OLDE TITLE THING - AD HOC;
04400 IF LENGTH(TITLE)≠0 THEN
04500 ⊂ DPYBIG(7);AIVECT(-100,-460);DPYSTR(TITLE);DPYBIG(2) ⊃;
04600 DPYOUT(2);
04700 END "DPYSUB";
00100 α GEOMED BODY DISPLAY;
00200 SUBR BDPY (ITG B);
00300 BEGIN "BDPY"
00400 ITG LOC;
00500 IF ¬FLAGD THEN RETURN;
00600 DPYBIG(1);
00700 AIVECT(-512,-150);
00800 DPYSTR(
00900 "-3. "&(IF NIP(B-3)<0 THEN "-" ELSE "")&ISTR(ABS(NIP(B-3)))&
01000 ",,"&(IF NAP(B-3)<0 THEN "-" ELSE "")&ISTR(ABS(NAP(B-3)))&↓
01100 &"-2. "&ISTR(CAR(B-2))&",,"&CVOS(CDR(B-2))&↓
01200 &"-1. "&ISTR(CAR(B-1))&",,"&ISTR(CDR(B-1))&↓&↓
01300
01400 &"0. "&CVOS(CAR(B+0))&",,"& CVS(CDR(B+0))&↓&↓
01500
01600 &"1. "&ISTR(NFACE(B))&",,"&ISTR(PFACE(B))&↓
01700 &"2. "&ISTR(NED(B)) &",,"&ISTR(PED(B)) &↓
01800 &"3. "&ISTR(NVT(B)) &",,"&ISTR(PVT(B)) &↓&↓
01900
02000 &"4. FCNT="& CVS(FCNT(B)) &",,VCNT="& CVS(VCNT(B))&↓
02100 &"5. ECNT="& CVS(ECNT(B)) &",,PCNT="& CVS(PCNT(B))&↓
02200 &"6. "&ISTR(NBODY(B))&",,"&ISTR(PBODY(B)) );
02300
02400 LOC←LOCOR(B);
02500 IF LOC=0 THEN RETURN;
02600 SETFORMAT(0,3);
02700 AIVECT(-512,+150);
02800 DPYSTR(
02900 CVF(XWC(LOC))&" "&CVF(YWC(LOC))&" "&CVF(ZWC(LOC))&↓&
03000 CVF( IX(LOC))&" "&CVF( IY(LOC))&" "&CVF( IZ(LOC))&↓&
03100 CVF( JX(LOC))&" "&CVF( JY(LOC))&" "&CVF( JZ(LOC))&↓&
03200 CVF( KX(LOC))&" "&CVF( KY(LOC))&" "&CVF( KZ(LOC)) );
03300
03400 END "BDPY";
00100 α GEOMED FACE DISPLAY;
00200 SUBR FDPY (ITG F);
00300 BEGIN "FDPY"
00400 ITG E,E0,E1,V;
00500
00600 IF FLAGV ∨ FLAGL THEN
00700 BEGIN
00800 ITG X1,Y1,X2,Y2,I;
00900 DPYBRT(3);DPYBIG(1);E←E0←PED(F);I←0;
01000 IF E≠0 THEN
01100 DO BEGIN
01200 I←I+1; IF ('40 LAND CAR(E)) α VISIBLE(E); THEN
01300 BEGIN
01400 X1←X1DC(E); Y1←Y1DC(E);
01500 X2←X2DC(E); Y2←Y2DC(E);
01600 AIVECT(X1,Y1); AVECT(X2,Y2);
01700 AIVECT((X1+X2)%2+VERNX,(Y1+Y2)%2+VERNY);
01800 DPYSTR(CVS(I));
01900 END;
02000 E1←E;E←ECCW(E,F);
02100 END UNTIL E=E0 ∨ E=E1;
02200 DPYBRT(2);
02300 END;
02400
02500
02600 IF ¬FLAGD THEN RETURN;
02700 DPYBIG(1);
02800 AIVECT(-512,-150);
02900 DPYSTR(
03000 "-3. A = "&CVF(LACR(F-3))&↓
03100 &"-2. B = "&CVF(LACR(F-2))&↓
03200 &"-1. C = "&CVF(LACR(F-1))&↓&↓
03300
03400 &"0. "&CVOS(CAR(F+0))&",,"& CVS(CDR(F+0))&↓&↓
03500
03600 &"1. "&ISTR(CAR(F+1))&",,"&ISTR(CDR(F+1))&↓
03700 &"2. NCNT="&CVS(NIP(F+2))&",,"&ISTR(CDR(F+2))&↓
03800 &"3. QQ="&CVOS(LAC(F+3))&↓
03900 &"4. K = "&CVF(LACR(F+4)) );
04000
04100 END "FDPY";
00100 α GEOMED EDGE DISPLAY;
00200 SUBR EDPY (ITG E);
00300 BEGIN "EDPY"
00400 ITG V;
00500 DPYBIG(1);
00600
00700 IF FLAGV ∨ FLAGL THEN
00800 BEGIN
00900 V←PVT(E);IF (CAR(V)LAND '017400)=0 THEN
01000 ⊂ AIVECT(XDC(V),YDC(V));DPYSTR("+");⊃;
01100 V←NVT(E);IF (CAR(V)LAND '017400)=0 THEN
01200 ⊂ AIVECT(XDC(V),YDC(V));DPYSTR("-");⊃;
01300 AIVECT((X1DC(E)+X2DC(E))/2,
01400 (Y1DC(E)+Y2DC(E))/2);
01500 END;
01600
01700 IF FLAGV THEN DPYSTR("o");
01800 IF FLAGL THEN DPYSTR("E"&CVS(SERIAL(E)));
01900
02000 IF ¬FLAGD THEN RETURN;
02100 DPYBIG(1);
02200 AIVECT(-512,-150);
02300 DPYSTR(
02400 "-3. A = "&CVF(LACR(E-3))&↓
02500 &"-2. B = "&CVF(LACR(E-2))&↓
02600 &"-1. C = "&CVF(LACR(E-1))&↓&↓
02700
02800 &"0. "&CVOS(CAR(E+0))&",,"& CVS(CDR(E+0))&↓&↓
02900
03000 &"1. "&ISTR(CAR(E+1))&",,"&ISTR(CDR(E+1))&↓
03100 &"2. "&ISTR(CAR(E+2))&",,"&ISTR(CDR(E+2))&↓
03200 &"3. "&ISTR(CAR(E+3))&",,"&ISTR(CDR(E+3))&↓&↓
03300
03400 &"4. "&ISTR(CAR(E+4))&",,"&ISTR(CDR(E+4))&↓
03500 &"5. "&ISTR(CAR(E+5))&",,"&ISTR(CDR(E+5))&↓&↓
03600
03700 &"6. "&ISTR(CAR(E+6))&",,"&ISTR(CDR(E+6)) );
03800
03900 END "EDPY";
00100 α GEOMED VERTEX DISPLAY;
00200 SUBR VDPY (ITG V);
00300 BEGIN "VDPY"
00400 DPYBIG(1);
00500 IF (FLAGV ∨ FLAGL) ∧ (CAR(V)LAND '017400)=0 THEN ⊂
00600 AIVECT(XDC(V)+VERNX,YDC(V)+VERNY);
00700 IF FLAGV THEN DPYSTR("o");
00800 IF FLAGL THEN DPYSTR("V"&CVS(SERIAL(V)));⊃;
00900 IF ¬FLAGD THEN RETURN;
01000 AIVECT(-512,-150);
01100 SETFORMAT(0,3);
01200 DPYSTR(
01300 "-3. X = "&CVF(LACR(V-3))&↓
01400 &"-2. Y = "&CVF(LACR(V-2))&↓
01500 &"-1. Z = "&CVF(LACR(V-1))&↓&↓
01600
01700 &"0. "&CVOS(CAR(V+0))&",,"& CVS(CDR(V+0))&↓&↓
01800
01900 &"1. "&CVS(LACR(V+1))&",,"&ISTR(CDR(V+1))&↓
02000 &"2. "&CVS(LACR(V+2))&",,"&ISTR(CDR(V+2))&↓
02100 &"3. "&ISTR(CAR(V+3))&",,"&ISTR(CDR(V+3))&↓&↓
02200
02300 &"4. X = "&CVS(LACR(V+4))&↓
02400 &"5. Y = "&CVS(LACR(V+5))&↓
02500 &"6. Z = "&CVS(LACR(V+6)) );
02600
02700 END "VDPY";
00100 α REFRESH THE DISPLAY OF THE CURRENT EDITOR STATUS;
00200 DEFINE TWICE = "FOR J←1 STEP 1 UNTIL 2 DO";
00300 INTERNAL PROCEDURE GEDREF;
00400 BEGIN "GED REFRESH"
00500 EXTERNAL STRING WORLDNAME;
00600 INTEGER PTR,NNN,I,J;
00700 REAL X,Y,Z;
00800 INTEGER ARRAY DPYBUF[1:400];
00900 STRING STR;
01000
01100 α HONOR THE DISPLAY SUPRESS SWITCHES;
01200 IF FLAGRS THEN RETURN;
01300 IF FLAGED THEN BEGIN HYDPOG(0);RETURN END;
01400
01500 α INITIALIZE DISPLAY;
01600 DPYSET(DPYBUF);
01700 AIVECT(-511,0);
01800 SETFORMAT(0,4);
00100 α LOWER RIGHT HAND CORNER - WORLD STATUS;
00200 SUNTIME; SUN;
00300 AIVECT(300,-410);
00400 DPYSTR(WORLDNAME&" WORLD");
00500 AIVECT(200,-435);DPYSTR(DAYTIME);
00600 AIVECT(200,-460);
00700 DPYSTR(" AZIMUTH ALTITUDE");
00800
00900
01000 SETFORMAT(6,1);
01100 AIVECT(200,-480);
01200 DPYSTR("SUN "&
01300 CVF(SUNAZM*180/π)&" "&CVF(SUNALT*180/π));
01400 AIVECT(200,-500);
01500 DPYSTR("CAM "&
01600 CVF(CAMAZM*180/π)&" "&CVF(CAMALT*180/π));
01700 SETFORMAT(0,4);
00100 α DISPLAY THE STATE OF THE EUCLIDEAN TRANSFORM SWITCHES;
00200 DPYSVS(180,500,
00300 (CASE FRAME OF ("WORLD"," BODY","RELATIVE","CAMERA"))
00400 &" FRAME"&(IF FRMORG THEN " *" ELSE " "));
00500 DPYSVS(390,500,
00600 (CASE OPERATION OF
00700 ("TRANSLATION","ROTATION","DILATION","REFLECTION")));
00800
00900 α DISPLAY THE STRENGTHS;
01000 DPYSVS(185,480,CVF(TDEL)&" FEET");
01100 AIVECT(185,460);
00100 α RDEL IN PI FRACTION;
00200 IF 6.28>RDEL ∧ RDEL>1 THEN
00300 BEGIN DPYSTR("2π/");DPYSTR(CVS(2*π/RDEL)) END ELSE
00400 IF RDEL<1 THEN
00500 BEGIN DPYSTR("π/");DPYSTR(CVS(3.1415927/RDEL))END;
00600
00700 α RDEL IN RADIANS;
00800 DPYSVS(385,460,CVG(RDEL));
00900
01000 α RDEL IN DEGREES, MINUTES AND SECONDS;
01100 ⊂ INTEGER D,M,S;
01200 S ← RDEL*206264.806;
01300 D ← S DIV 3600;
01400 S ← S MOD 3600;
01500 M ← S DIV 60;
01600 S ← S MOD 60;
01700 DPYSVS(285,460,CVS(D)&" "&CVS(M)&" "&CVS(S));⊃;
01800
01900 α DILATION STRENGTH;
02000 DPYSVS(390,480,CVF(DDEL*100)&" %"&CVS(AXECNT));
02100
02200 α BODY COUNTS;
02300 DPYSVS(180,440,CVS(BTOTAL)&"B "&CVS(FTOTAL)&"F "
02400 &CVS(ETOTAL)&"E "&CVS(VTOTAL)&"V ");
02500 ⊂ EXTERNAL ITG CORSIZ;DPYSVS(180,420,CVS(CORSIZ)&" WORDS");⊃;
00100 α DISPLAY THE SCRATCH PAD PDL;
00200 AIVECT(-511,430);
00300 IF PDLPTR=0 THEN ⊂ DPYOUT(0);RETURN ⊃;
00400 FOR PTR←PDLPTR STEP -1 UNTIL (1 MAX (PDLPTR-20)) DO
00500 DPYSTR(ISTR(PADPDL[PTR])&↓);
00600
00700 CASE ITYPE(TOP) OF
00800 ⊂ ;BDPY(TOP);FDPY(TOP);EDPY(TOP);VDPY(TOP);⊃;
00900
01000 ⊂ ITG SAV;SAV←FLAGD;FLAGD←FALSE;
01100 IF PDLPTR≥2 ∧ ETYPE(TOP) THEN
01200 IF VTYPE(ARG1) THEN VDPY(ARG1) ELSE
01300 IF FTYPE(ARG1) THEN FDPY(ARG1);
01400 FLAGD←SAV;⊃;
01500
01600 DPYOUT(0);
01700 END "GED REFRESH";
01800
01900 END "GEODPY";